PC Plus SuperCD (UK) 1997 February/PC Plus Super CD (Issue 124) (PCP124-2-97) (February 1997).iso/ms/vb5cce/controls/samples/clrbox2/clrbox2.exe/clsTimer.cls

Visual Basic class definition | 1996-10-25 | 5.7 KB | 134 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsTimer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'-------------------------------------------------------------------------
'This class provides a Timer object and will support multiple instanciations.
'There are two key properties: Enabled, and Interval.
'Needed Files:
'   modTimer.bas    Is needed because it contains the TimerProc function
'                   whose address is passed in the SetTimer API.
'   clsTmLnk.cls    Is needed because there must not be internal references
'                   of clsTimer.  Instead of adding a reference of clsTimer
'                   to a collection for the TimerProc function to access,
'                   clsTimer creates an instance of clsTimerLink holds a
'                   a reference and adds a reference of it to the global
'                   collection for the use of TimerProc.  TimerProc can
'                   then trigger clsTimerLink which will trigger clsTimer
'-------------------------------------------------------------------------

Private Const mlDEFAULT_INTERVAL As Long = 1

Private mlTimerID As Long           'The ID of the system timer created by this object
Private mlInterval As Long          'The interval of this timer
Private mbTimerStarted As Boolean   'If true, a system timer is set for this object
Private mbEnabled As Boolean        'Equals the enabled property of this object

Private WithEvents moTimerLink As clsTimerLink  'clsTimerLink object that can raise
Attribute moTimerLink.VB_VarHelpID = -1
                                                'an event to this object

Public Event Timer()

'***********************
'Public Properties
'***********************

Public Property Let Interval(lInterval As Long)
    '-------------------------------------------------------------------------
    'Purpose:   Changes the interval of the Timer
    'In:        [lInterval]
    '               The new interval to set the timer to.
    'Effects:   [mlInterval]
    '               Becomes equal to lInterval
    '           Calls SetInterval only if there is a system timer corresponding
    '           to this object
    '-------------------------------------------------------------------------
    If mlInterval <> lInterval Then
        mlInterval = lInterval
        If mbTimerStarted Then
            SetInterval lInterval, mlTimerID
        End If
    End If
End Property

Public Property Get Interval() As Long
    Interval = mlInterval
End Property

Public Property Let Enabled(bEnabled As Boolean)
    '-------------------------------------------------------------------------
    'Purpose:   Starts a system timer if bEnabled is true
    '           Stops the timer if bEnabled is false
    'Effects:   [mbEnabled] is set equal to bEnabled
    '           [mbTimerStarted] is set to true if StartTimer succeeds
    '                            is set to false if StopTimer succeeds
    '           If true a new system timer is started and the TimerID
    '           is stored in a class level variable so that this object
    '           can effect the specific system timer.
    '           This object then instanciates a clsTimerLink object and
    '           adds it to a global collection using the TimerID converted
    '           to a string a key.  The a reference to clsTimerLink object
    '           is stored as a class level with events variable.
    '           Timer proc will call the clsTimerLink object which will
    '           raise an event to this object which will handle the event
    '           and raise it to what ever object instanciated this object.
    '           clsTimerLink is used because an internal reference of this
    '           object can not be stored or the Terminate event will not
    '           fire when the object that instanciated this object destroys
    '           ist reference.
    '           The callback function will receive TimerID's and will
    '           only raiseevent to the corresponding object
    '           If bEnable is false the system timer is killed and
    '           this object is removed from the global collection
    '-------------------------------------------------------------------------
    Dim lReturn As Long

    mbEnabled = bEnabled    'Even if calling KillTimer fails
                            'This object will stop raising events

    If bEnabled <> mbTimerStarted Then
        If bEnabled Then
            mlTimerID = StartTimer(mlInterval)
            If mlTimerID <> 0 Then
                mbTimerStarted = True
                Set moTimerLink = New clsTimerLink
                gcTimerObjects.Add moTimerLink, Str$(mlTimerID)
            End If
        Else
            lReturn = StopTimer(mlTimerID)
            If lReturn = 1 Then
                mbTimerStarted = False
                gcTimerObjects.Remove Str$(mlTimerID)
            End If
        End If
    End If
End Property

Public Property Get Enabled() As Boolean
    Enabled = mbTimerStarted
End Property

Private Sub Class_Initialize()
    'Make sure a gcTimerObjects collection is instanciated
    If gcTimerObjects Is Nothing Then Set gcTimerObjects = New Collection
    mlInterval = mlDEFAULT_INTERVAL
End Sub

Private Sub Class_Terminate()
    'Make sure the system timer is killed or a GPF will occur when
    'the system calls a function on a dying process
    If mbTimerStarted Then Enabled = False
End Sub

Private Sub moTimerLink_Tick()
    'Raise the Timer event to the object that instanciated Me.
    RaiseEvent Timer
End Sub